home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #067 (1990-04)(Amiga User Group Deutschland e.V.).adf / Examples / Moire.p < prev    next >
Text File  |  1989-07-02  |  3KB  |  140 lines
  1. Program Moire;
  2.  
  3.     { This program just draws a Moire pattern in a window.
  4.       It uses a surprising breadth of functions, so it shows
  5.       off a bit of what PCQ can do.  And it works to boot. }
  6.  
  7. {$I ":Include/Exec.i" for Forbid, Permit and library things }
  8. {$I ":Include/Ports.i" for the Message stuff }
  9. {$I ":Include/Intuition.i" for window & screen structures and functions }
  10. {$I ":Include/Graphics.i" for drawing stuff }
  11.  
  12. var
  13.     w  : WindowPtr;
  14.     s  : ScreenPtr;
  15.     m  : MessagePtr;
  16.  
  17. Function OpenTheScreen() : Boolean;
  18. var
  19.     ns : NewScreenPtr;
  20. begin
  21.     new(ns);
  22.     with ns^ do begin
  23.     LeftEdge := 0;
  24.     TopEdge  := 0;
  25.     Width    := 640;
  26.     Height   := 200;
  27.     Depth    := 2;
  28.     DetailPen := 3;
  29.     BlockPen  := 2;
  30.     ViewModes := 32768;
  31.     SType     := CUSTOMSCREEN_f;
  32.     Font      := nil;
  33.     DefaultTitle := "Close the Window to End This Demonstration";
  34.     Gadgets   := nil;
  35.     CustomBitMap := nil;
  36.     end;
  37.     s := OpenScreen(ns);
  38.     dispose(ns);
  39.     OpenTheScreen := s <> nil;
  40. end;
  41.  
  42. Function OpenTheWindow() : Boolean;
  43. var
  44.     nw : NewWindowPtr;
  45. begin
  46.     new(nw);
  47.     with nw^ do begin
  48.     LeftEdge := 20;
  49.     TopEdge := 50;
  50.     Width := 336;
  51.     Height := 100;
  52.  
  53.     DetailPen := -1;
  54.     BlockPen  := -1;
  55.     IDCMPFlags := CLOSEWINDOW_f;
  56.     Flags := WINDOWSIZING_f + WINDOWDRAG_f + WINDOWDEPTH_f +
  57.          WINDOWCLOSE_f + SMART_REFRESH_f + ACTIVATE_f;
  58.     FirstGadget := nil;
  59.     CheckMark := nil;
  60.     Title := "Feel Free to Re-Size the Window";
  61.     Screen := s;
  62.     BitMap := nil;
  63.     MinWidth := 50;
  64.     MaxWidth := -1;
  65.     MinHeight := 20;
  66.     MaxHeight := -1;
  67.     WType := CUSTOMSCREEN_f;
  68.     end;
  69.  
  70.     w := OpenWindow(nw);
  71.     dispose(nw);
  72.     OpenTheWindow := w <> nil;
  73. end;
  74.  
  75. Procedure DoDrawing(RP : RastPortPtr);
  76. var
  77.     x  : Short;
  78.     Pen : Byte;
  79.     Stop : Short;
  80. begin
  81.     Pen := 1;
  82.     while true do begin
  83.     with w^ do begin
  84.         x := 0;
  85.         while x <= (Width - BorderRight - BorderLeft) do begin
  86.         Stop := Width - BorderRight;
  87.         SetAPen(RP, Pen);
  88.         Move(RP, x + BorderLeft, BorderTop);
  89.         Draw(RP, Stop - x, Height - BorderBottom);
  90.         Pen := (Pen + 1) mod 4;
  91.         m := GetMsg(UserPort);
  92.         if m <> nil then
  93.             return;
  94.         x := Succ(x);
  95.         end;
  96.         x := 0;
  97.         while x <= (Height - BorderBottom - BorderTop) do begin
  98.         Stop := Height - BorderBottom;
  99.         SetAPen(RP, Pen);
  100.         Move(RP, Width - BorderRight, x + BorderTop);
  101.         Draw(RP, BorderLeft, Stop - x);
  102.         Pen := (Pen + 1) mod 4;
  103.         m := GetMsg(UserPort);
  104.         if m <> nil then
  105.             return;
  106.         x := Succ(x);
  107.         end;
  108.     end;
  109.     end;
  110. end;
  111.  
  112. begin
  113.     { Note that the startup code of all PCQ programs depends on
  114.       Intuition, so if we got to this point Intuition must be
  115.       open, so the run time library just uses the pointer that
  116.       the startup code created.  Same with DOS, although we don't
  117.       use that here. }
  118.  
  119.     GfxBase := OpenLibrary("graphics.library", 0);
  120.     if GfxBase <> nil then begin
  121.     if OpenTheScreen() then begin
  122.         if OpenTheWindow() then begin
  123.         DoDrawing(w^.RPort);
  124.         Forbid;
  125.         repeat
  126.             m := GetMsg(w^.UserPort);
  127.         until m = nil;
  128.         CloseWindow(w);
  129.         Permit;
  130.         end else
  131.         writeln('Could not open the window');
  132.         CloseScreen(s);
  133.     end else
  134.         writeln('Could not open the screen.');
  135.     CloseLibrary(GfxBase);
  136.     end else
  137.     writeln('Could not open graphics.library');
  138. end.
  139.  
  140.